home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 1159.ZIP / REPCALDU.PRG < prev    next >
Text File  |  1986-12-08  |  4KB  |  165 lines
  1. RNUM=RECNO()
  2. ENDREC=RECCOUNT()
  3. GO RNUM
  4. CLEAR
  5. DO CASE
  6.  CASE ENDREC # 1
  7.   @ 1,7+INT(LOG(ENDREC)/LOG(10))+INT(LOG(RECNO())/LOG(10)) SAY ENDREC
  8.   ??' records.  '
  9.   ??'Data base in use:  '
  10.   ?? OSS
  11.   @ 1,2+INT(LOG(RECNO())/LOG(10)) SAY RECNO()
  12.   ??' of '
  13.   @ 1,0 SAY 'Record No.'
  14.   DO CASE
  15.    CASE RECNO()=ENDREC
  16.     ?'End of listing'
  17.    CASE RECNO()=1
  18.     ?'Beginning of listing'
  19.   ENDCASE
  20.    CASE ENDREC=1
  21.     ?'There is only 1 record in this listing.'
  22. ENDCASE
  23. @ 2,41 SAY 'DATE ERROR ===> '
  24. ?? DUEDATE
  25. @ 3,0 SAY INSTNAME
  26. @ 3,23 SAY SERIALNUM
  27. @ 3,40 SAY TVANUMBER
  28. @ 3,57 SAY CALIBDATE
  29. @ 3,70 SAY 'NEXT DATE'
  30. DO CASE
  31.  CASE BY_DATE=100
  32.   @ 5,56 SAY TDREMARK
  33.  CASE BY_DATE=200
  34.   @ 5,58 SAY DREMARK
  35. ENDCASE
  36. @ 6,0 SAY INST_TYPE
  37. @ 6,23 SAY SERIAL_NO
  38. @ 6,40 SAY TVA_NO
  39. @ 6,58 SAY CALIB_DATE
  40. @ 6,70 SAY CAL_DUE_DT
  41.   PT=0
  42.   IF CAT3ABB $ SUBCATID
  43.    ?'/'
  44.    ?? CATEGORY3
  45.    ??'/   '
  46.    PT=1
  47.   ENDIF
  48.   IF SUB1ABB $ SUBCATID
  49.    IF PT=0
  50.     ?'('
  51.     ?? SUBCAT1
  52.     ??')   '
  53.     PT=1
  54.    ELSE
  55.     ??'('
  56.     ?? SUBCAT1
  57.     ??')   '
  58.    ENDIF
  59.   ENDIF
  60.   IF SUB2ABB $ SUBCATID
  61.    IF PT=0
  62.     ?'('
  63.     ?? SUBCAT2
  64.     ??')   '
  65.     PT=1
  66.    ELSE
  67.     ??'('
  68.     ?? SUBCAT2
  69.     ??')   '
  70.    ENDIF
  71.   ENDIF
  72.   IF SUB3ABB $ SUBCATID
  73.    IF PT=0
  74.    ?'('
  75.    ?? SUBCAT3
  76.    ??')   '
  77.    ELSE
  78.    ??'('
  79.    ?? SUBCAT3
  80.    ??')   '
  81.    ENDIF
  82.   ENDIF
  83. @ 9,0 SAY LOCATNAME
  84. ??' :  '
  85. ?? LOCATION
  86. ??'   '
  87. ?? CALINTERVL
  88. ??' :  '
  89. ?? CALIB_INT
  90. ??'  months'
  91. DO CASE
  92.  CASE CALIB_INT=99
  93.   @ 9,60 SAY '/'
  94.   ?? CATEGORY2
  95.   ??'/'
  96.  CASE CALIB_INT=0
  97.   @ 9,60 SAY '/'
  98.   ?? CATEGORY3
  99.   ??'/'
  100. ENDCASE
  101. @ 11,0 SAY REMARK
  102. @ 14,0 SAY ' '
  103.      ?'With a CAL.INT. of '
  104.      ?? CALIB_INT
  105.      ??'  months, '
  106.      ??'the expected '
  107.      ?? DUEDATE
  108.      ??' is:  '
  109.      ?? CALCDUDT
  110.      ?'What is the correct '
  111.      ?? DUEDATE
  112.      ??' ?'
  113.      ACCEPT 'Date format:  ##/##/##           DATE:  ' TO CALDUEDT
  114.      ?
  115.      ?'What is the correct '
  116.      ?? CALIBDATE
  117.      ??' ?'
  118.      ACCEPT 'Date format:  ##/##/##           DATE:  ' TO CALDAT
  119.      ?
  120.      @ ROW()+1,41 SAY 'month(s)'
  121.      @ ROW()-2,79
  122.      ?
  123.      ACCEPT 'What is the correct time interval ?  ' TO CALIBINT
  124.      CALIBIN=VAL(LTRIM(TRIM(CALIBINT)))
  125.      @ 23,34 SAY 'WORKING . . .'
  126.      CALDAT=UPPER(LTRIM(TRIM(CALDAT)))
  127.      CALDUEDT=UPPER(LTRIM(TRIM(CALDUEDT)))
  128.      DO CASE
  129.        CASE AT('.O.',CALDAT)=1 .OR. AT('.0.',CALDAT)=1
  130.          IF LEN(CALDAT)>3
  131.            REPLACE CALIB_DATE WITH CTOD(LTRIM(RIGHT(CALDAT,LEN(CALDAT)-3)))
  132.          ENDIF
  133.          CALOVER=100
  134.          REPLACE BY_DATE WITH CALOVER
  135.        CASE AT('.PO.',CALDAT)=1 .OR. AT('.P0.', CALDAT)=1
  136.          IF LEN(CALDAT)>4
  137.            REPLACE CALIB_DATE WITH CTOD(LTRIM(RIGHT(CALDAT,LEN(CALDAT)-4)))
  138.          ENDIF
  139.          CALOVER=200
  140.          REPLACE BY_DATE WITH CALOVER
  141.        CASE LEN(CALDAT)#0
  142.          REPLACE CALIB_DATE WITH CTOD(CALDAT)
  143.      ENDCASE
  144.      DO CASE
  145.        CASE AT('.O.',CALDUEDT)=1 .OR. AT('.0.',CALDUEDT)=1
  146.          IF LEN(CALDUEDT)>3
  147.            REPLACE CAL_DUE_DT WITH CTOD(LTRIM(RIGHT(CALDUEDT,LEN(CALDUEDT)-3)))
  148.          ENDIF
  149.          CALOVER=100
  150.          REPLACE BY_DATE WITH CALOVER
  151.        CASE AT('.PO.',CALDUEDT)=1 .OR. AT('.P0.',CALDUEDT)=1
  152.          IF LEN(CALDUEDT)>4
  153.            REPLACE CAL_DUE_DT WITH CTOD(LTRIM(RIGHT(CALDUEDT,LEN(CALDUEDT)-4))) 
  154.          ENDIF
  155.          CALOVER=200
  156.          REPLACE BY_DATE WITH CALOVER
  157.        CASE LEN(CALDUEDT)#0
  158.          REPLACE CAL_DUE_DT WITH CTOD(CALDUEDT)
  159.     ENDCASE
  160.     IF LEN(TRIM(CALIBINT))#0
  161.       REPLACE CALIB_INT WITH CALIBIN
  162.     ENDIF
  163.     RETURN
  164.  
  165.